home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b3.d64 / single file copy (.txt) < prev   
Commodore BASIC  |  2007-02-28  |  4KB  |  167 lines

  1. 20 REM SINGLE DRIVE FILE COPY
  2. 40 POKE52,31:POKE56,31:CLR
  3. 45 FORI=0TO173
  4. 50 READ D:POKE7936+I,D:NEXT
  5. 55 POKE785,0:POKE786,31
  6. 60 PL$=CHR$(19)
  7. 65 FORI=1TO24:PL$=PL$+CHR$(17):NEXT
  8. 70 FORI=1TO39:CL$=CL$+" ":NEXT
  9. 75 CL$=CL$+CHR$(13)+CL$+CHR$(13)
  10. 80 CL$=LEFT$(PL$,21)+CL$+CHR$(145)+CHR$(145)
  11. 85 OPEN15,8,15:REM OPEN ERROR CHANNEL
  12. 90 GOTO1000
  13. 100 REM
  14. 110 REM READ THE DIRECTORY
  15. 130 POKE785,0:REM SELECT READ FUNCTION
  16. 140 PRINT#15,"I":OPEN2,8,2,"$"
  17. 150 NB=USR(2):REM LOAD DIR INTO MEM
  18. 160 CLOSE 2:GOSUB 800:REM CHECK ERROR
  19. 170 RETURN
  20. 200 REM
  21. 210 REM DISPLAY DISK NAME
  22. 230 POKE785,6:REMSELECT FETCH CHAR
  23. 240 PRINT LEFT$(PL$,3);CHR$(18);
  24. 250 FORK=142TO169
  25. 260 PRINT CHR$(USR(K));:NEXT
  26. 270 PRINT CHR$(146)
  27. 280 RETURN
  28. 300 REM
  29. 310 REM PRINT DIRECTORY ENTRY DE
  30. 330 POKE 785,6:REM SELECT FETCH CHAR
  31. 340 IX=(DE-1)*32+254-INT((DE-1)/8)*2
  32. 345 IF USR(IX)<128 THEN RETURN
  33. 350 TY=USR(IX)-128:IFTY=0ORTY>3THEN RETURN
  34. 360 FOR K=IX+3 TO IX +18
  35. 370 PRINT CHR$(USR(K));
  36. 380 NEXT:PRINT TAB(16);",";
  37. 390 PRINT MID$("SPU",TY,1):RETURN
  38. 400 REM
  39. 410 REM GET DESTINATION DISK
  40. 430 PRINT CL$;
  41. 440 PRINT "INSERT DESTINATION DISK"
  42. 450 PRINT"PRESS";CHR$(18);"RETURN";
  43. 460 PRINT CHR$(146);"WHEN READY."
  44. 470 GETDM$:IFDM$=""GOTO470
  45. 480 IFDM$<>CHR$(13)GOTO470
  46. 490 PRINT#15,"I":RETURN
  47. 500 REM
  48. 510 REM GET A FILE TO COPY
  49. 530 PRINT CL$;:IF EN=63 GOTO 580
  50. 540 IF UE=128THEN PRINT NM$;"TOO LARGE.";
  51. 550 IFEN=62 THEN PRINT NM$;"NOT FOUND.";
  52. 560 PRINT"ENTER FILE,TYPE":NM$="":EN=0:UE=0
  53. 570 INPUT NM$,TY$:RETURN
  54. 580 PRINT NM$;"EXISTS. ENTER NEW NAME"
  55. 590 EN=0:NM$="":INPUT NM$:RETURN
  56. 600 REM
  57. 610 REM READ THE FILE
  58. 630 POKE 785,0:REM SELECT READ FUNCTION
  59. 640 OPEN 2,8,2,NM$+","+TY$+",R"
  60. 650 GOSUB 900:IF EN<>0 THEN CLOSE 2:RETURN
  61. 660 NB=USR(2):REM READ THE FILE
  62. 670 CLOSE 2:GOSUB 800:REM CHECK RESULTS
  63. 680 RETURN
  64. 700 REM
  65. 710 REM WRITE THE FILE
  66. 730 POKE 785,3:REM SELECT WRITE FUNCTION
  67. 740 OPEN 2,8,2,NM$+","+TY$+",W"
  68. 750 GOSUB 900:IF EN<>0 THEN CLOSE 2:RETURN
  69. 760 NB=USR(2):REM WRITE THE BYTES
  70. 770 CLOSE 2:GOSUB 800:REM CHECK RESULTS
  71. 780 RETURN
  72. 800 REM
  73. 810 REM CHECK USR() RETURN VALUE
  74. 830 NB=NB-(NB<0)*65536
  75. 840 IF NB<61440 THEN UE =0:RETURN
  76. 850 IF NB=61440 THEN UE =128:RETURN
  77. 860 PRINT CL$;
  78. 870 IFPEEK(785)=0 THEN PRINT "READ";
  79. 880 IF PEEK(785)=3 THEN PRINT "WRITE";
  80. 890 PRINT "ERROR #";NB-61440:END
  81. 900 REM
  82. 910 REM READ ERROR CHANNEL
  83. 940 INPUT#15,EN,EM$,ET,ES
  84. 950 IF EN=0OREN=62OREN=63 THEN RETURN
  85. 960 CLOSE 15: PRINT CL$;
  86. 970 PRINT "DISK ERROR #";EN
  87. 980 PRINT LEFT$(PL$,22);EM$:END
  88. 1000 REM
  89. 1010 REM MAIN ROUTINE
  90. 1030 PRINT CHR$(147);:REM CLEAR SCREEN
  91. 1040 PRINT"       SINGLE DRIVE FILE COPY"
  92. 1050 PRINT:PRINT "READING DIRECTORY"
  93. 1060 GOSUB 100:REM READ THE DIRECTORY
  94. 1070 GOSUB 200:REM DISPLAY THE TITLE
  95. 1080 NS=INT((NB+1)/254)
  96. 1090 IFNS=1 GOTO 5000:REM NO FILES
  97. 1100 DS=1
  98. 1110 IF NS<=DS THEN DS=1:REM START OVER
  99. 1120 PRINTLEFT$(PL$,4);
  100. 1130 BE=(DS-1)*8+1:LE=BE+15
  101. 1140 IFDS+1=NSTHEN LE=BE+8
  102. 1150 FOR DE= BE TO LE
  103. 1160 GOSUB 300:NEXT:REM DISPLAY FILES
  104. 1170 FORI=PEEK(214)TO20:REM CLEAR
  105. 1180 PRINT"                    "
  106. 1190 NEXT
  107. 1200 GOSUB 500:REM GET FILE NAME
  108. 1210 IF NM$="" THEN DS=DS+2:GOTO 1110
  109. 2010 REMCOPYTHE FILE
  110. 2030 PRINT CL$;
  111. 2040 PRINT"READING ";NM$
  112. 2050 GOSUB 600:REM READ THE FILE
  113. 2060 IF EN=62ORUE=128 GOTO 1200
  114. 2070 BC=NB:REM SAVE COUNT
  115. 2080 GOSUB 400:REM GET DEST DISK
  116. 2090 PRINT CL$;"WRITING ";NM$
  117. 2100 GOSUB 700:REM WRITE THE FILE
  118. 2110 IF EN=0 GOTO 3000
  119. 2120 GOSUB 500:REM GET NEW FILE
  120. 2130 IF NM$<>""GOTO  2090
  121. 2140 PRINT CL$;FILE NOT COPIED"
  122. 2150 [137] 3100
  123. 3000 [143]
  124. 3010 [143] DISPLAY COMPLETION STATUS
  125. 3030 [153] CL$;
  126. 3040 [139] NB[179][177]BC [137] 3060
  127. 3050 [153]"COPY SUCCESSFUL.  ";:[137]3070
  128. 3060 [153]"ERROR ONLY ";NB;" OUT";
  129. 3070 [153] BC;"BYTES COPIED."
  130. 3100 [153] "PRESS";[199](18);
  131. 3110 [153]"RETURN";[199](146);
  132. 3120 [153]"TO COPY ANOTHER FILE"
  133. 3130 [161]DM$:[139]DM$[178]""[137]3130
  134. 3140 [139] DM$[178][199](13) [137] 1000
  135. 3150 [128]
  136. 4010 [143] NO FILES ERROR HANDLING
  137. 4030 [153] [200](PL$,21);
  138. 4040 [153]"NO FILES ON THIS DISK"
  139. 4050 [153]"PRESS RETURN TO TRY";
  140. 4060 [153] "ANOTHER DISK.";
  141. 4070 [161]DM$:[139] DM$[178]""[137]4070
  142. 4080 [139] DM$[178][199](13)[137] 1000
  143. 4090 [128]
  144. 5000 [143]
  145. 10000 [131]76,15,31,76,88,31,76,154
  146. 10010 [131]31,108,3,0,108,5,0,32
  147. 10020 [131]9,31,152,170,32,198,255,168
  148. 10030 [131]176,57,169,0,133,251,169,32
  149. 10040 [131]133,252,160,0,32,207,255,145
  150. 10050 [131]251,230,251,208,2,230,252,165
  151. 10060 [131]144,208,13,165,252,201,160,144
  152. 10070 [131] 235,32,204,255,160,0,240,19
  153. 10080 [131]164,144,32,204,255,192,64,208
  154. 10090 [131]10,164,251,165,252,56,233,32
  155. 10100 [131] 76,12,31,169,240,76,12,31
  156. 10110 [131]32,9,31,152,170,32,201,255
  157. 10120 [131]168,176,240,165,251,141,174,31
  158. 10130 [131]165,252,141,175,31,169,0,133
  159. 10140 [131]251,169,32,133,252,160,0,177
  160. 10150 [131]251,32,210,255,164,144,208,20
  161. 10160 [131]230,251,208,2,230,252,165,252
  162. 10170 [131]205,175,31,144,234,165,251,205
  163. 10180 [131]174,31,144,227,32,204,255,76
  164. 10190 [131]73,31,32,9,31,132,251,24
  165. 10200 [131]105,32,133,252,160,0,177,251
  166. 10210 [131]168,169,0,76,12,31
  167.